Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Feb/di9802dm/treeview/TreeViewXImpl.pas

Pascal/Delphi Source File | 1997-10-31 | 9.0 KB | 333 lines

{This ActiveX control was created for a Delphi Informant article.}
{  "Using and Creating ActiveX Controls" (February 1998)}
{  by Dan Miser}
{}
{We must remove the references to non-OLE compatible types. Specifically,}
{this requires re-working the Items property, which refers to TTreeNodes.}
{We can manipulate TTreeNodes *within* the ActiveX control (OCX), but we must}
{present the OCX user with an interface that contains types which are OLE}
{compatible. We could use 3 different methods:}
{  1) Procedural interface for all read/write access. AddRoot, AddChild}
{  2) Set 2 properties to control Level and Index, which will uniquely}
{     identify a TTreeNode. We can then Add, Delete, or Insert from there.}
{  3) Pass in string "Root/Child1/Child2" and translate to TTreeNodes structure.}

{Left to implement:
  1) Images and StateImages properties
  2) Cursor and DragMode properties}

unit TreeViewXImpl;

interface

uses
  ComObj, ActiveX, AxCtrls, ComCtrls, Graphics, Forms,
  TreeViewX_TLB;

type
  TTreeViewX = class(TActiveXControl, ITreeViewX)
  private
    FDelphiControl: TTreeView;
    FEvents: ITreeViewXEvents;
  protected
    procedure InitializeControl; override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    function Get_Color: TColor; safecall;
    procedure Set_Color(Value: TColor); safecall;
    procedure AddChild(const RootIndex, Index: Integer; const S: WideString);
      safecall;
    procedure AddRoot(const Index: Integer; const S: WideString); safecall;
    function Get_ShowLines: WordBool; safecall;
    function Get_ShowRoot: WordBool; safecall;
    procedure Set_ShowLines(Value: WordBool); safecall;
    procedure Set_ShowRoot(Value: WordBool); safecall;
    function AlphaSort: WordBool; safecall;
    function Get_BorderStyle: TxBorderStyle; safecall;
    function Get_Ctl3D: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: Font; safecall;
    function Get_HideSelection: WordBool; safecall;
    function Get_Indent: Integer; safecall;
    function Get_ReadOnly: WordBool; safecall;
    function Get_SortType: TxSortType; safecall;
    function Get_Visible: WordBool; safecall;
    procedure Delete; safecall;
    procedure FullCollapse; safecall;
    procedure FullExpand; safecall;
    procedure LoadFromFile(const FileName: WideString); safecall;
    procedure SaveToFile(const FileName: WideString); safecall;
    procedure Set_BorderStyle(Value: TxBorderStyle); safecall;
    procedure Set_Ctl3D(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: Font); safecall;
    procedure Set_HideSelection(Value: WordBool); safecall;
    procedure Set_Indent(Value: Integer); safecall;
    procedure Set_ReadOnly(Value: WordBool); safecall;
    procedure Set_SortType(Value: TxSortType); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    function Get_RightClickSelect: WordBool; safecall;
    function Get_ShowButtons: WordBool; safecall;
    procedure Set_RightClickSelect(Value: WordBool); safecall;
    procedure Set_ShowButtons(Value: WordBool); safecall;
    function IsEditing: WordBool; safecall;
    procedure ITreeViewX.AddChild = ITreeViewX_AddChild;
    procedure ITreeViewX.AddRoot = ITreeViewX_AddRoot;
    procedure ITreeViewX_AddChild(RootIndex, Index: Integer;
      const S: WideString); safecall;
    procedure ITreeViewX_AddRoot(Index: Integer; const S: WideString);
      safecall;
  end;

implementation

uses ComServ;

procedure TTreeViewX.InitializeControl;
begin
  FDelphiControl := Control as TTreeView;
end;

procedure TTreeViewX.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as ITreeViewXEvents;
end;

procedure TTreeViewX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_DBTreeViewXPage); }
end;

function TTreeViewX.Get_Color: TColor;
begin
  Result := FDelphiControl.Color;
end;

procedure TTreeViewX.Set_Color(Value: TColor);
begin
  FDelphiControl.Color := Value;
end;

procedure TTreeViewX.AddChild(const RootIndex, Index: Integer; const S: WideString);
var
  ARoot, AChild : TTreeNode;
  i : integer;
begin
  {Find the right root position}
  ARoot:=FDelphiControl.Items.GetFirstNode;
  for i:=0 to RootIndex-1 do
    if ARoot<>nil then
      ARoot:=ARoot.GetNextSibling;

  {Now find the right child position}
  if (ARoot<>nil) and (ARoot.HasChildren) then begin
    AChild:=ARoot.GetFirstChild;
    for i:=0 to Index-1 do
      if (AChild<>nil) and (AChild.GetNextChild(ARoot)<>nil) then
        AChild:=AChild.GetNextChild(ARoot);
    FDelphiControl.Items.Add(AChild, S);
  end
  else
    // If sorted, inserted in sort order; else, inserted as last child node
    FDelphiControl.Items.AddChild(ARoot, S);
end;

procedure TTreeViewX.AddRoot(const Index: Integer; const S: WideString);
begin
  if FDelphiControl.Items.Count=0 then
    FDelphiControl.Items.Add(nil, S)
  else
  if (Index>=0) and (Index<FDelphiControl.Items.Count) then
    FDelphiControl.Items.Add(FDelphiControl.Items[Index], S);
end;

function TTreeViewX.Get_ShowLines: WordBool;
begin
  Result := FDelphiControl.ShowLines;
end;

function TTreeViewX.Get_ShowRoot: WordBool;
begin
  Result := FDelphiControl.ShowRoot;
end;

procedure TTreeViewX.Set_ShowLines(Value: WordBool);
begin
  FDelphiControl.ShowLines := Value;
end;

procedure TTreeViewX.Set_ShowRoot(Value: WordBool);
begin
  FDelphiControl.ShowRoot := Value;
end;

function TTreeViewX.AlphaSort: WordBool;
begin
  Result:=FDelphiControl.AlphaSort;
end;

function TTreeViewX.Get_BorderStyle: TxBorderStyle;
begin
  Result := Ord(FDelphiControl.BorderStyle);
end;

function TTreeViewX.Get_Ctl3D: WordBool;
begin
  Result := FDelphiControl.Ctl3D;
end;

function TTreeViewX.Get_Enabled: WordBool;
begin
  Result := FDelphiControl.Enabled;
end;

function TTreeViewX.Get_Font: Font;
begin
  GetOleFont(FDelphiControl.Font, Result);
end;

function TTreeViewX.Get_HideSelection: WordBool;
begin
  Result := FDelphiControl.HideSelection;
end;

function TTreeViewX.Get_Indent: Integer;
begin
  Result := FDelphiControl.Indent;
end;

function TTreeViewX.Get_ReadOnly: WordBool;
begin
  Result := FDelphiControl.ReadOnly;
end;

function TTreeViewX.Get_SortType: TxSortType;
begin
  Result := Ord(FDelphiControl.SortType);
end;

function TTreeViewX.Get_Visible: WordBool;
begin
  Result := FDelphiControl.Visible;
end;

procedure TTreeViewX.Delete;
begin

end;

procedure TTreeViewX.FullCollapse;
begin
  FDelphiControl.FullCollapse;
end;

procedure TTreeViewX.FullExpand;
begin
  FDelphiControl.FullExpand;
end;

procedure TTreeViewX.LoadFromFile(const FileName: WideString);
begin
  FDelphiControl.LoadFromFile(FileName);
end;

procedure TTreeViewX.SaveToFile(const FileName: WideString);
begin
  FDelphiControl.SaveToFile(FileName);
end;

procedure TTreeViewX.Set_BorderStyle(Value: TxBorderStyle);
begin
  FDelphiControl.BorderStyle := TBorderStyle(Value);
end;

procedure TTreeViewX.Set_Ctl3D(Value: WordBool);
begin
  FDelphiControl.Ctl3D := Value;
end;

procedure TTreeViewX.Set_Enabled(Value: WordBool);
begin
  FDelphiControl.Enabled := Value;
end;

procedure TTreeViewX.Set_Font(const Value: Font);
begin
  SetOleFont(FDelphiControl.Font, Value);
end;

procedure TTreeViewX.Set_HideSelection(Value: WordBool);
begin
  FDelphiControl.HideSelection := Value;
end;

procedure TTreeViewX.Set_Indent(Value: Integer);
begin
  FDelphiControl.Indent := Value;
end;

procedure TTreeViewX.Set_ReadOnly(Value: WordBool);
begin
  FDelphiControl.ReadOnly := Value;
end;

procedure TTreeViewX.Set_SortType(Value: TxSortType);
begin
  FDelphiControl.SortType := TSortType(Value);
end;

procedure TTreeViewX.Set_Visible(Value: WordBool);
begin
  FDelphiControl.Visible := Value;
end;

function TTreeViewX.Get_RightClickSelect: WordBool;
begin
  Result := FDelphiControl.RightClickSelect;
end;

function TTreeViewX.Get_ShowButtons: WordBool;
begin
  Result := FDelphiControl.ShowButtons;
end;

procedure TTreeViewX.Set_RightClickSelect(Value: WordBool);
begin
  FDelphiControl.RightClickSelect := Value;
end;

procedure TTreeViewX.Set_ShowButtons(Value: WordBool);
begin
  FDelphiControl.ShowButtons := Value;
end;

function TTreeViewX.IsEditing: WordBool;
begin
  Result:=FDelphiControl.IsEditing;
end;

procedure TTreeViewX.ITreeViewX_AddChild(RootIndex, Index: Integer;
  const S: WideString);
begin

end;

procedure TTreeViewX.ITreeViewX_AddRoot(Index: Integer;
  const S: WideString);
begin

end;

initialization
  TActiveXControlFactory.Create(
    ComServer,
    TTreeViewX,
    TTreeView,
    Class_TreeViewX,
    1,
    '',
    0);
end.